Extension { #name : 'Context' }

{ #category : '*System-Support' }
Context >> errorReportOn: stream [
	"Write a detailed error report on the stack (above me) on a
	stream.  For both the error file, and emailing a bug report.
	Suppress any errors while getting printStrings.  Limit the length."

	| stackDepth aContext |
	"The packae System-Time is not loaded during the first steps of the bootstrap. Thus we print the date only if we have the necessary classes loaded in the system. Else we at least print the useful info."
	self class environment at: #Date ifPresent: [ :date |
			self class environment at: #Time ifPresent: [ :time |
					stream
						print: date today;
						space;
						print: time now;
						cr ] ].

	stream cr.
	stream
		nextPutAll: 'VM: ';
		nextPutAll: Smalltalk os name;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk os subtype;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk os version;
		nextPutAll: ' - ';
		nextPutAll: Smalltalk vm version;
		cr.
	
	self class environment at: #SystemVersion ifPresent: [ :class |
		stream
			nextPutAll: 'Image: ';
			nextPutAll: class current asString;
			cr.
 ].

	stream cr. "Note: The following is an open-coded version of  Context>>stackOfSize: since this method may be called during a  low space condition and we might run out of space for allocating the  full stack."
	stackDepth := 0.
	aContext := self.
	[ aContext isNotNil and: [ (stackDepth := stackDepth + 1) < 40 ] ] whileTrue: [ "variable values"
			aContext printDetails: stream.
			stream cr.
			aContext := aContext sender ].
	stream
		cr;
		nextPutAll: '--- The full stack ---';
		cr.
	aContext := self.
	stackDepth := 0.
	[ aContext == nil ] whileFalse: [
			stackDepth := stackDepth + 1.
			stackDepth = 40 ifTrue: [
					stream
						nextPutAll: ' - - - - - - - - - - - - - - -
			- - - - - - - - - - - - - - - - - -';
						cr ]. "just class>>selector"
			stream
				print: aContext;
				cr.
			stackDepth > 200 ifTrue: [
					stream nextPutAll: '-- and more not shown --'.
					^ self ].
			aContext := aContext sender ]
]
